home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / Pocket Forth rel.5 / Text files / Sieve < prev    next >
Encoding:
Text File  |  1991-07-21  |  1.1 KB  |  36 lines  |  [TEXT/EDIT]
  1. ( Sleeve of Erastothanes )
  2. ( optomized for Pocket Forth with inline machine code )
  3. ( based on a letter by Don Colburn in DDJ #83 )
  4. forget task : TASK ;  decimal  0 28 +md !
  5. 9000 room - grow  ( provide for 9000 dictionary bytes )
  6.  
  7. ( tenth second timer )
  8. : START ( -- d ) 362 0 dl@ ;  ( get 'ticks' )
  9. : T. ( sec -- ) s>d <# # 46 hold #S #> type ;  ( print sec.tenths )
  10. : STOP ( d -- ) start cr 2swap dnegate d+ drop  6 / t. ." sec." ;
  11.  
  12. ( compile machine code inline routines )
  13. : R+ ( n -- n+r ) ( add the loop index to the number on the stack )
  14.     ,$ 3017 ,$ D156 ; macro  ( move.w [rs],d0 add.w d0,[ps] )
  15. : 0RC! ( -- ) ( clear the byte pointed to by the index loop )
  16.     ,$ 3017 ,$ 4233 ,$ 0 ; macro  ( move.w [rs],d0 clr.b 0[bp,d0] )
  17.  
  18. 8190 constant SIZE
  19. variable FLAGS size allot
  20.  
  21. : PRIME  flags size 1 fill
  22.     0 size 0 DO
  23.       flags r+ c@ IF
  24.         3 r+ r+ dup r+ size < IF
  25.           size flags + over r+ flags +
  26.           DO  0rc! dup  +LOOP
  27.         THEN drop 1+
  28.       THEN
  29.     LOOP . ." primes" cr ;
  30.  
  31. : SIEVE  page  ."        The Sieve of Erastothanes" decimal
  32.     cr  start  10 BEGIN prime 1- DUP 0= UNTIL DROP stop
  33.     beep cr  ." Not too shabby, eh?"  cr ;
  34.  
  35. sieve
  36.